home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2posx10.zoo / m2posix.10 / src / cmdline.ipp < prev    next >
Encoding:
Modula Implementation  |  1993-12-23  |  15.2 KB  |  511 lines
  1. IMPLEMENTATION MODULE cmdline;
  2. __IMP_SWITCHES__
  3. __DRIVER__ (* ARGV muss auf jeden Fall aus dem Environment entfernt werden *)
  4. #ifdef HM2
  5. #ifdef __LONG_WHOLE__
  6. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  7. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  8. #else
  9. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  10. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  11. #endif
  12. #endif
  13. (*****************************************************************************)
  14. (* 18-Sep-93, Holger Kleinschmidt                                            *)
  15. (*****************************************************************************)
  16.  
  17. /* Folgende Zeile in 'C'-Kommentarklammern setzen, falls der Programmname
  18.  * nicht ueber "shel_read()" ermittelt werden soll, wenn kein ARGV-Verfahren
  19.  * benutzt wurde.
  20.  * Da das Ermitteln des Programmnamens auf diese Weise fuer TOS-Programme
  21.  * nicht ganz ``sauber'' ist, sollten die Kommentarklammern normalerweise
  22.  * gesetzt sein!
  23.  * Die GEM-Aufrufe sind fuer die GEM-Bibliothek ``crystal'' von
  24.  * Ulrich Kaiser ausgelegt, wer eine andere GEM-Bibliothek verwendet, muss
  25.  * die Aufrufe entsprechend anpassen.
  26.  */
  27.  
  28. /*
  29. #define USE_AES_FOR_ARGV0
  30. */
  31.  
  32. VAL_INTRINSIC
  33. CAST_IMPORT
  34.  
  35. FROM SYSTEM IMPORT
  36. (* TYPE *) ADDRESS,
  37. (* PROC *) ADR, TSIZE;
  38.  
  39. FROM PORTAB IMPORT
  40. (* CONST*) NULL,
  41. (* TYPE *) UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG;
  42.  
  43. FROM OSCALLS IMPORT
  44. (* PROC *) Fsetdta, Malloc;
  45.  
  46. FROM ctype IMPORT
  47. (* PROC *) isspace, isdigit, tocard;
  48.  
  49. FROM DosSystem IMPORT
  50. (* TYPE *) BasePtr, BasePage, CmdLine,
  51. (* VAR  *) BASEP;
  52.  
  53. FROM types IMPORT
  54. (* CONST*) EOS,
  55. (* TYPE *) StrRange, ArrayRange, StrPtr, StrArray;
  56.  
  57. FROM cstr IMPORT
  58. (* PROC *) AssignCToM2;
  59.  
  60. #ifdef USE_AES_FOR_ARGV0
  61. FROM pSTRING IMPORT EQUALN;
  62.  
  63. FROM AES IMPORT
  64. (* PROC *) Version;
  65.  
  66. FROM ApplMgr IMPORT
  67. (* PROC *) ApplInit, ApplExit;
  68.  
  69. FROM ShelMgr IMPORT
  70. (* PROC *) ShelRead;
  71. #endif
  72.  
  73. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  74.  
  75. VAR
  76.   dta     : ARRAY [0..43] OF CHAR; (* Platz fuer Default-DTA *)
  77.   ARGV    : StrArray;  (* -> Feld von Zeigern auf die Kommando-Argumente *)
  78.   ENVP    : StrArray;  (* -> Feld von Zeigern auf die Environment-Variablen *)
  79.   ARGC    : CARDINAL;  (* Anzahl der Kommando-Argumente *)
  80.   prgName : CmdLine;   (* Name des Programms, falls feststellbar *)
  81.   cmdBuf  : CmdLine;   (* Arbeitskopie der Basepage-Kommandozeile *)
  82.   null    : StrPtr;
  83.  
  84. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  85.  
  86. PROCEDURE main ((* -- /AUS *) VAR argc : ArrayRange;
  87.                 (* -- /AUS *) VAR argv : StrArray   );
  88. (*T*)
  89. BEGIN
  90.  argc := ARGC;
  91.  argv := ARGV;
  92. END main;
  93.  
  94. (*---------------------------------------------------------------------------*)
  95.  
  96. PROCEDURE getenv ((* EIN/ -- *) REF var : ARRAY OF CHAR ): StrPtr;
  97. (*T*)
  98. VAR __REG__ varIdx : StrRange;
  99.     __REG__ varPtr : StrPtr;
  100.             val    : ArrayRange;
  101.  
  102. BEGIN
  103.  val    := 0;
  104.  varPtr := ENVP^[0];
  105.  WHILE varPtr <> NULL DO
  106.    varIdx := 0;
  107.    WHILE (VAL(CARDINAL,varIdx) <= VAL(CARDINAL,HIGH(var)))
  108.      AND (var[varIdx] <> 0C)
  109.      AND (var[varIdx] = varPtr^[varIdx])
  110.    DO
  111.      INC(varIdx);
  112.    END;
  113.  
  114.    IF (   (VAL(CARDINAL,varIdx) > VAL(CARDINAL,HIGH(var)))
  115.        OR (var[varIdx]     = 0C))
  116.       AND (varPtr^[varIdx] = '=')
  117.    THEN
  118.      RETURN(CAST(StrPtr,ADR(varPtr^[varIdx+1])));
  119.    END;
  120.  
  121.    INC(val);
  122.    varPtr := ENVP^[val];
  123.  END;
  124.  
  125.  RETURN(NULL);
  126. END getenv;
  127.  
  128. (*---------------------------------------------------------------------------*)
  129.  
  130. PROCEDURE ArgCount ( ): CARDINAL;
  131. (*T*)
  132. BEGIN
  133.  RETURN(ARGC);
  134. END ArgCount;
  135.  
  136. (*---------------------------------------------------------------------------*)
  137.  
  138. PROCEDURE GetArg ((* EIN/ -- *)     i   : CARDINAL;
  139.                   (* -- /AUS *) VAR arg : ARRAY OF CHAR );
  140. (*T*)
  141. BEGIN
  142.  IF i < ARGC THEN
  143.    AssignCToM2(ARGV^[VAL(ArrayRange,i)], arg);
  144.  ELSE
  145.    arg[0] := EOS;
  146.  END;
  147. END GetArg;
  148.  
  149. (*---------------------------------------------------------------------------*)
  150.  
  151. PROCEDURE GetEnvVar ((* EIN/ -- *) REF var : ARRAY OF CHAR;
  152.                      (* -- /AUS *) VAR val : ARRAY OF CHAR ): BOOLEAN;
  153. (*T*)
  154. BEGIN
  155.  AssignCToM2(getenv(var), val);
  156.  RETURN(val[0] <> EOS);
  157. END GetEnvVar;
  158.  
  159. (*---------------------------------------------------------------------------*)
  160.  
  161. PROCEDURE initargs;
  162. (*T*)
  163. (* Initialisieren der Programmargumente und Environmentvariablen.
  164.    Als Prozedur, damit Registervariablen deklariert werden koennen.
  165.  *)
  166. VAR __REG__ envPtr  : StrPtr;
  167.     __REG__ cmdPtr  : StrPtr;
  168.     __REG__ envIdx  : StrRange;
  169.     __REG__ srcIdx  : StrRange;
  170.     __REG__ dstIdx  : StrRange;
  171.     __REG__ c       : CHAR;
  172.             EXARG   : BOOLEAN;
  173.             EXNULL  : BOOLEAN;
  174.             ENV     : BOOLEAN;
  175. #ifdef USE_AES_FOR_ARGV0
  176.             AUTO    : BOOLEAN;
  177. #endif
  178.     __REG__ i       : ArrayRange;
  179.             cmdLen  : StrRange;
  180.             nullIdx : StrRange;
  181.             argIdx  : StrRange;
  182.             envSize : CARDINAL;
  183.             args    : ArrayRange;
  184.             vars    : ArrayRange;
  185.             mem     : ADDRESS;
  186.  
  187. BEGIN
  188.   EXARG  := FALSE;
  189.   EXNULL := FALSE;
  190.   ARGC   := 0;
  191.   args   := 0;
  192.   vars   := 0;
  193.   null   := NULL;
  194.   ARGV   := CAST(StrArray,ADR(null));
  195.   ENVP   := CAST(StrArray,ADR(null));
  196.   envPtr := BASEP^.pEnv;
  197.  
  198.   Fsetdta(ADR(dta));  (* damit bleibt die Kommandozeile ungeschoren *)
  199.   BASEP^.pDta := ADR(dta);
  200.  
  201.   ENV := (envPtr <> NULL) AND (envPtr^[0] <> 0C);
  202.   IF ENV THEN
  203.     (* Zuerst wird nach ARGV gesucht, und, falls vorhanden, abgetrennt,
  204.      * sodass der Rest einheitlich als Environment behandelt werden
  205.      * kann. Das ARGV-Verfahren benutzt naemlich nicht das Standardformat
  206.      * fuer Environmentvariablen und darf nicht bei der evtl. noetigen
  207.      * Formatkorrektur des Environments beruecksichtigt werden.
  208.      *)
  209.     envIdx := 0;
  210.     LOOP
  211.       IF EXARG THEN
  212.         INC(args);
  213.       ELSE
  214.         IF    (envPtr^[envIdx]   = 'A')
  215.           AND (envPtr^[envIdx+1] = 'R')
  216.           AND (envPtr^[envIdx+2] = 'G')
  217.           AND (envPtr^[envIdx+3] = 'V')
  218.           AND (envPtr^[envIdx+4] = '=')
  219.         THEN
  220.           envPtr^[envIdx]   := 0C;
  221.           envPtr^[envIdx+1] := 0C; (* Falls ARGV erste (und einzige) Variable *)
  222.           IF MWCStyle OR (BASEP^.pCmdlin[0] = CHR(127)) THEN
  223.             EXARG := TRUE;
  224.             IF    (envPtr^[envIdx+5] = 'N')
  225.               AND (envPtr^[envIdx+6] = 'U')
  226.               AND (envPtr^[envIdx+7] = 'L')
  227.               AND (envPtr^[envIdx+8] = 'L')
  228.               AND (envPtr^[envIdx+9] = ':')
  229.             THEN
  230.               INC(envIdx, 10);
  231.               nullIdx := envIdx;
  232.               EXNULL  := TRUE;
  233.             ELSE
  234.               INC(envIdx, 5);
  235.             END;
  236.             (* Wert der ARGV-Variable (erstmal) ueberlesen *)
  237.             WHILE envPtr^[envIdx] <> 0C DO
  238.               INC(envIdx);
  239.             END;
  240.             INC(envIdx); (* Hier beginnt der Programmname *)
  241.             IF envPtr^[envIdx] = 0C THEN
  242.               (* Environment zuende: Fehler, kein ARGV *)
  243.               EXARG  := FALSE;
  244.               EXNULL := FALSE;
  245.               EXIT;
  246.             ELSE
  247.               argIdx := envIdx;
  248.               args   := 1;
  249.             END;
  250.           ELSE
  251.             EXIT; (* ARGV entspricht nicht dem Atari-Standard *)
  252.           END;
  253.         END;
  254.       END;
  255.       WHILE envPtr^[envIdx] <> 0C DO
  256.         INC(envIdx);
  257.       END;
  258.       INC(envIdx);
  259.       IF envPtr^[envIdx] = 0C THEN EXIT; END;
  260.     END; (* LOOP *)
  261.   END; (* IF ENV *)
  262.  
  263.   IF args = 0 THEN
  264.     args    := 1; (* mindestens Programmname *)
  265.     prgName := "";
  266.     cmdBuf  := BASEP^.pCmdlin;
  267.  
  268. #ifdef USE_AES_FOR_ARGV0
  269. #  warning ...using AES for argv[0]
  270.  
  271.     AUTO := FALSE;
  272.     IF Version() = 0 THEN
  273.       IF ApplInit() < 0 THEN
  274.         AUTO := Version() = 0;
  275.       ELSE
  276.         ApplExit;
  277.       END;
  278.     END;
  279.  
  280.     IF NOT AUTO THEN
  281.       (* AES bereits initialisiert *)
  282.       ShelRead(prgName, cmdBuf);
  283.       IF NOT EQUALN(ORD(cmdBuf[0])+1, cmdBuf, BASEP^.pCmdlin) THEN
  284.         (* Plausibilitaetstest: Wenn die Kommandozeile nicht mit der aus
  285.          * der Basepage uebereinstimmt, ist dieses Programm vermutlich
  286.          * nicht mit "ShelWrite" gestartet worden, und die Ergebnisse
  287.          * von "ShelRead()" stimmen nicht.
  288.          * Dieser Test klappt nicht immer: z.B. nicht, wenn aufrufendes
  289.          * Programm (per ShelWrite gestartet) und aufgerufenes
  290.          * Programm (durch Pexec) ohne Argumente gestartet werden,
  291.          * dann sind naemlich auch beide Kommandozeilen gleich.
  292.          *)
  293.         prgName := "";
  294.         cmdBuf  := BASEP^.pCmdlin;
  295.       END;
  296.     END;
  297. #endif
  298.  
  299.     (* Kommandozeile untersuchen, falls kein (korrektes) ARGV-Verfahren
  300.      * verwendet wurde.
  301.      * Es wird angenommen, dass im ersten Byte der Kommandozeile die
  302.      * korrekte Laenge der Kommandozeile steht (ist das sicher?)!
  303.      *
  304.      * Zuerst muss die Anzahl der Argumente ermittelt werden.
  305.      *)
  306.     cmdLen := ORD(cmdBuf[0]);  (* Laenge der Kommandozeile *)
  307.     IF cmdLen > 124 THEN
  308.       cmdLen := 124;           (* max. 124 Zeichen ausschl. Laengenbyte *)
  309.     END;
  310.  
  311.     dstIdx := 0;
  312.     srcIdx := 1;               (* Laengenbyte ueberspringen *)
  313.     (* Ueberfluessige Leerzeichen zwischen den Argumenten entfernt;
  314.      * dafuer werden sie mit Nullbyte abgeschlossen. Dieses wird aber
  315.      * nur in einer Kopie der Basepage-Kommandozeile vorgenommen.
  316.      *)
  317.     REPEAT
  318.       WHILE (srcIdx <= cmdLen) AND isspace(cmdBuf[srcIdx]) DO
  319.         (* Leerzeichen vor dem Argument entfernen.
  320.          * Entfernt auch das abschliessende CR des Desktops.
  321.          *)
  322.         INC(srcIdx);
  323.       END;
  324.       IF cmdBuf[srcIdx] < ' ' THEN
  325.         (* Controlzeichen (z.B. 0C) beendet auch die Kommandozeile *)
  326.         srcIdx := cmdLen + 1;
  327.       END;
  328.       IF srcIdx <= cmdLen THEN
  329.         WHILE (srcIdx <= cmdLen) AND (cmdBuf[srcIdx] > ' ')  DO
  330.           (* Argument ohne Leerzeichen nach vorne schieben *)
  331.           cmdBuf[dstIdx] := cmdBuf[srcIdx];
  332.           INC(srcIdx);
  333.           INC(dstIdx);
  334.         END;
  335.         cmdBuf[dstIdx] := 0C; (* Argument durch Nullbyte abschliessen *)
  336.         INC(srcIdx);          (* Argumentende ueberspringen *)
  337.         INC(dstIdx);
  338.         INC(args);
  339.       END;
  340.     UNTIL srcIdx > cmdLen;
  341.   END; (* IF args = 0 *)
  342.  
  343.   IF ENV THEN
  344.     (* Jetzt muss das Environment evtl. korrigiert werden, da der
  345.      * Desktop die Variablen in einem anderen Format als ueblich
  346.      * ablegt (z.B.: "PATH=",0C,"A:\",0C, statt "PATH=A:\",0C).
  347.      * Gleichzeitig wird die Anzahl der Variablen ermittelt.
  348.      *)
  349.     srcIdx := 0;
  350.     dstIdx := 0;
  351.     REPEAT
  352.       REPEAT
  353.         (* Variablenname kopieren, dabei evtl. nach vorne verschieben *)
  354.         c := envPtr^[srcIdx];
  355.         envPtr^[dstIdx] := c;
  356.         INC(srcIdx);
  357.         INC(dstIdx);
  358.       UNTIL (c = 0C) OR (c = '=');
  359.  
  360.       IF (c = '=') THEN
  361.         (* Variable hat evtl. einen Wert *)
  362.         IF (envPtr^[srcIdx] = 0C) AND (envPtr^[srcIdx+1] <> 0C) THEN
  363.           envIdx := srcIdx;
  364.           REPEAT
  365.             INC(envIdx);
  366.             c := envPtr^[envIdx];
  367.           UNTIL (c = 0C) OR (c = '=');
  368.           IF c = 0C THEN
  369.             (* eingeschobenes Nullbyte ignorieren *)
  370.             INC(srcIdx);
  371.           END;
  372.         END;
  373.         REPEAT
  374.           (* Variablenwert kopieren, einschliesslich abschl. NullByte *)
  375.           c := envPtr^[srcIdx];
  376.           envPtr^[dstIdx] := c;
  377.           INC(srcIdx);
  378.           INC(dstIdx);
  379.         UNTIL c = 0C;
  380.       END;
  381.       INC(vars);
  382.     UNTIL envPtr^[srcIdx] = 0C;
  383.     envPtr^[dstIdx] := 0C; (* Environment beendet *)
  384.   END; (* IF ENV *)
  385.  
  386.   envSize := VAL(CARDINAL,(args + vars + 2)) * VAL(CARDINAL,TSIZE(StrPtr));
  387.   (* + 2 wegen Nullpointer *)
  388.   IF NOT Malloc(VAL(SIGNEDLONG, envSize), mem) THEN
  389.     args := 0;
  390.     vars := 0;
  391.   ELSE
  392.     ENVP := CAST(StrArray,mem);
  393.     IF ENV THEN
  394.       envIdx := 0;
  395.       FOR i := 0 TO vars - 1 DO  (* vars > 0 ist gesichert *)
  396.         ENVP^[i] := CAST(StrPtr,ADR(envPtr^[envIdx]));
  397.         REPEAT
  398.           INC(envIdx);
  399.         UNTIL envPtr^[envIdx] = 0C;
  400.         INC(envIdx); (* Die Null *)
  401.       END;
  402.     END; (* IF ENV *)
  403.     ENVP^[vars] := NULL;
  404.  
  405.     ARGV := CAST(StrArray,ADR(ENVP^[vars+1]));
  406.     IF EXARG THEN
  407.       envIdx := argIdx;
  408.       FOR i := 0 TO args - 1 DO  (* args > 0 ist gesichert *)
  409.         ARGV^[i] := CAST(StrPtr,ADR(envPtr^[envIdx]));
  410.         REPEAT
  411.           INC(envIdx);
  412.         UNTIL envPtr^[envIdx] = 0C;
  413.         INC(envIdx);
  414.       END;
  415.  
  416.       IF EXNULL THEN
  417.         (* Die Indexliste der leeren Argumente besteht aus durch
  418.          * Kommata getrennten Dezimalzahlen. Beim ersten ungueltigen
  419.          * Zeichen (einschliesslich dem beendenden Nullbyte) wird die
  420.          * Liste als beendet betrachtet.
  421.          *)
  422.         WHILE isdigit(envPtr^[nullIdx]) DO
  423.           (* Zeichenkette in einen Index wandeln.
  424.            * Ohne Ueberlaufpruefung usw.
  425.            *)
  426.           i := 0;
  427.           REPEAT
  428.             i := i * 10 + VAL(ArrayRange,tocard(envPtr^[nullIdx]));
  429.             INC(nullIdx);
  430.           UNTIL NOT isdigit(envPtr^[nullIdx]);
  431.  
  432.           IF i < args THEN
  433.             (* Schutz-Leerzeichen des leeren Arguments loeschen *)
  434.             ARGV^[i]^[0] := 0C;
  435.           END;
  436.           IF envPtr^[nullIdx] = ',' THEN
  437.             (* Es folgt eine weitere Zahl *)
  438.             INC(nullIdx);
  439.           END;
  440.         END;
  441.       END;
  442.  
  443.       (* Soviel wie moeglich vom ARGV-Environment in die Basepage-Kommandozeile
  444.        * kopieren, falls dies vom Aufrufer nicht getan wurde. Der Programmname
  445.        * wird uebersprungen.
  446.        *)
  447.       cmdBuf[0] := CHR(127);
  448.       i      := 1;
  449.       dstIdx := 1;
  450.       WHILE (i < args) AND (dstIdx <= 124) DO
  451.         srcIdx := 0;
  452.         cmdPtr := ARGV^[i]; INC(i);
  453.         IF cmdPtr^[0] = 0C THEN
  454.           (* Leeres Argument *)
  455.           cmdBuf[dstIdx]   := "'";
  456.           cmdBuf[dstIdx+1] := "'";
  457.           INC(dstIdx, 2);
  458.         ELSE
  459.           (* Argument kopieren *)
  460.           REPEAT
  461.             cmdBuf[dstIdx] := cmdPtr^[srcIdx];
  462.             INC(srcIdx);
  463.             INC(dstIdx);
  464.           UNTIL (cmdPtr^[srcIdx] = 0C) OR (dstIdx > 124);
  465.         END;
  466.  
  467.         (* dstIdx <= 126 ist gesichert *)
  468.         IF i < args THEN
  469.           (* Ende des Arguments erreicht *)
  470.           cmdBuf[dstIdx] := ' ';
  471.           INC(dstIdx);
  472.         ELSE
  473.           (* Ende der Argumentliste erreicht *)
  474.           cmdBuf[dstIdx] := 0C;
  475.         END;
  476.       END;
  477.  
  478.       (* Die restliche Kommandozeile wird geloescht. *)
  479.       IF dstIdx > 125 THEN
  480.         dstIdx := 125;
  481.       END;
  482.       WHILE dstIdx < 128 DO
  483.         cmdBuf[dstIdx] := 0C;
  484.         INC(dstIdx);
  485.       END;
  486.       BASEP^.pCmdlin := cmdBuf;
  487.  
  488.     ELSE (* NOT EXARG *)
  489.       ARGV^[0] := CAST(StrPtr,ADR(prgName));
  490.       srcIdx   := 0;
  491.       FOR i := 1 TO args - 1 DO
  492.         ARGV^[i] := CAST(StrPtr,ADR(cmdBuf[srcIdx]));
  493.         REPEAT
  494.           INC(srcIdx);
  495.         UNTIL cmdBuf[srcIdx] = 0C;
  496.         INC(srcIdx);
  497.       END;
  498.     END;
  499.   END; (* IF mem = NULL *)
  500.  
  501.   ARGV^[args] := NULL;
  502.   ARGC        := VAL(CARDINAL,args);
  503.   environ     := ENVP;
  504. END initargs;
  505.  
  506. (*===========================================================================*)
  507.  
  508. BEGIN (* cmdline *)
  509.  initargs;
  510. END cmdline.
  511.